home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / EXTRAC.f < prev    next >
Text File  |  1992-07-31  |  2KB  |  43 lines
  1.       SUBROUTINE EXTRAC(NUMBER,OPTION)  
  2. *-----------------------------------------------------------------------
  3. *   
  4. * extracts the FORTRAN field contents from the statement image. 
  5. * holl.  and character strings are included in special characters,  
  6. * '{' and '}'. strings may be either ...H, or be
  7. * included in single or double quotes.  
  8. *   
  9. *--- input  
  10. *    NUMBER          number of the statement to be extracted
  11. *    OPTION          (character) 'FULL' or 'PART' to extract
  12. *                    all, or just start (up to first bracket)   
  13. *    SIMA            COMMON/ALCAZA/ (contains one complete routine) 
  14. *    NLTYPE,ICLASS,NFLINE,NLLINE,  COMMON/STATE/
  15. *   
  16. *--- output 
  17. *    SSTA            COMMON/ALCAZA/  FORTRAN fields 7-72 of SIMA
  18. *    NCHST           COMMON/STATE/  last non-blank in SSTA  
  19. *                    or =0 if statement consists of comment lines only  
  20. *    NLIMA, NLREF(1..NLIMA),   /STATE/  
  21. *    STATUS(3)      if illegal (containing '{', '}' )   
  22. *   
  23. *   
  24. *-----------------------------------------------------------------------
  25.       include 'PARAM.h' 
  26.       include 'ALCAZA.h' 
  27.       include 'FLAGS.h' 
  28.       include 'CURSTA.h' 
  29.       include 'STATE.h' 
  30.       CHARACTER OPTION*4
  31.       NCHST=0   
  32.       NSTREF=0  
  33.       IF (NUMBER.LE.0.OR.NUMBER.GT.NSTAMM) GOTO 999 
  34.       IF (ICLASS(NUMBER,1).EQ.0) GOTO 999   
  35.       NSTREF=NUMBER 
  36. *--- compact statement into SSTA
  37.       CALL COMPAC(NUMBER)   
  38.       IF (NCHST.EQ.0) GOTO 999  
  39. *--- insert {} around strings, suppress multiple blanks 
  40.       CALL MARKST(OPTION,IERR)  
  41.       STATUS(3)=IERR.NE.0   
  42.   999 END   
  43.